home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 061-070 / amok63 / m2ced / txt.lha / M2CED.mod < prev    next >
Text File  |  1991-11-13  |  12KB  |  479 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    M2CED.mod
  4.     :Contents.   Working with CED
  5.     :Author.     Steffen Reith
  6.     :Address.    Hessenstr. 64, D-8700 Wuerzburg
  7.     :Phone.      None
  8.     :Copyright.  Shareware
  9.     :Language.   Modula-2
  10.     :Translator. M2Amiga A+L V3.2d
  11.     :Imports.    ARP, CED, ErrorMsg, Errors, Keys, req, Msg, Config
  12.     :System.     $$Date: 17-06-1991  13:14:59
  13.     :System.     $$CompilerRuns #13#
  14.     :History.    V1.0   9. June   1990
  15.                  V1.1  12. June   1990 Some bugs fixed
  16.                  V1.2  18. June   1990 Configuration added
  17.                  V1.21 10. July   1990 little changes in Compile and Link
  18.                  V1.3   7. August 1990 Key for M2O added
  19.                  V1.31 23. Oct    1990 Fast load for "Fehler-Meldungen"
  20.                  V1.32  6. Feb    1991 little Bug fixed
  21.                  V1.4  13. Mrz    1991 New: UpdateVersion
  22.                  V1.41 16. Jun    1991 New: Changed for M2Amiga V4.0
  23. **********************************************************************)
  24. (*$ StackParms:=FALSE Volatile:=FALSE CaseChk:=FALSE *)
  25. (*$ StackChk:=FALSE RangeChk:=FALSE OverflowChk:=FALSE NilChk:=FALSE *)
  26. MODULE M2CED;
  27.  
  28. FROM ARP         IMPORT SyncRun,GADS,ToUpper;
  29. FROM Arts        IMPORT dosCmdBuf,dosCmdLen;
  30. FROM CED         IMPORT Fehler,FehlerType,Status,PutMsg2CED,TalkCED,KillString,
  31.                         Ergeb;
  32. FROM ErrorMsg    IMPORT ReadList,KillList,FindMsg,String,NodePtr;
  33. FROM Errors      IMPORT ExistErrorFile,OpenErrorFile,NextError,CloseErrorFile,
  34.                         ErrorFeld;
  35. FROM Keys        IMPORT KeyPressed,Action;
  36. FROM req         IMPORT DSize,FChars,PathTypePtr,PathType,GetString;
  37. FROM IntuitionL  IMPORT DisplayBeep,WBenchToFront;
  38. FROM SYSTEM      IMPORT ADDRESS,ADR;
  39. FROM DosD        IMPORT FileHandle,FileHandlePtr,newFile,readWrite,oldFile,
  40.                         FileLockPtr,sharedLock;
  41. FROM DosL        IMPORT Open,Close,Delay,Write,Execute,CurrentDir,Lock,UnLock;
  42. FROM String      IMPORT Concat,Compare,Length;
  43. FROM Conversions IMPORT ValToStr;
  44. FROM Msg         IMPORT TitleMsg,Request;
  45. FROM Config      IMPORT P,Para,WriteFile,ReadFile;
  46. FROM Ver         IMPORT UpdateVersion;
  47.  
  48. CONST ExtLen=4; (* Laenge der Namensextension *)
  49.       Template='N=NameOnly/s,A=Argument/s,R=NoRestart/s,V=NoVersion';
  50.       HelpMsg='Usage: M2CED [nur Filename] [Argument erfragen] [NoRestart] [NoVersion]';
  51.       CopyRightMsgC=' M2CED Version1.4(alpha) © by Steffen Reith is active';
  52.  
  53. TYPE ExtType=ARRAY[0..ExtLen] OF CHAR; (* Laenge nur fuer M2-Amiga geeignet *)
  54.      Sort=(FullPath,NameOnly);
  55.      BOOLEANPtr=POINTER TO BOOLEAN;
  56.      ArgType=RECORD
  57.               NameO,Argument,NoRestart,NoVersion:BOOLEANPtr
  58.              END;
  59.      DosWin=ARRAY[0..63] OF CHAR;
  60.  
  61. VAR Root:NodePtr;
  62.     Key:CARDINAL;
  63.     StartArgument:ARRAY[0..255] OF CHAR;
  64.     CopyRightMsg:ARRAY[0..63] OF CHAR;
  65.     Flag,ErrorsOn:BOOLEAN;
  66.     Argc:INTEGER;
  67.     Arg:ArgType;
  68.     Old:FileLockPtr;
  69.     OldFile,OpenName:PathType;
  70.     Compiled:BOOLEAN;
  71.     OffSet:LONGINT;
  72.     Jump,JumpNo:ARRAY[0..16] OF CHAR;
  73.  
  74. PROCEDURE ReportCEDError();
  75.  
  76. VAR Text:ARRAY[0..31] OF CHAR;
  77.  
  78. BEGIN
  79.  CASE Fehler OF
  80.   |ok:Text:='Internal FATAL Error';
  81.   |noReply:Text:='Keine Replyport';
  82.   |noCED:Text:='Kein CED da !!!!';
  83.  END;
  84.  Request(Text)
  85. END ReportCEDError;
  86.  
  87. PROCEDURE Cont();
  88.  
  89. VAR Erg:Action;
  90.  
  91. BEGIN
  92.  REPEAT
  93.   Erg:=KeyPressed()
  94.  UNTIL Erg=continue
  95. END Cont;
  96.  
  97. PROCEDURE ChangeDir(VAR Dir:ARRAY OF CHAR);
  98.  
  99. VAR MyLock:FileLockPtr;
  100.     Msg:ARRAY[0..31] OF CHAR;
  101.  
  102. BEGIN
  103.  MyLock:=Lock(ADR(Dir),sharedLock);
  104.  IF MyLock=NIL THEN
  105.   Msg:='Kann Directory nicht wechseln!';
  106.   TitleMsg(Msg);
  107.   RETURN
  108.  END;
  109.  MyLock:=CurrentDir(MyLock);
  110.  UnLock(MyLock)
  111. END ChangeDir;
  112.  
  113. PROCEDURE GetCEDFileExtension(VAR Ext:ExtType);
  114.  
  115. VAR Flag:BOOLEAN;
  116.     Help:PathType;
  117.     i:INTEGER;
  118.  
  119. BEGIN
  120.  
  121.  Flag:=TalkCED('Status 21'); (* Filenamen ohne Pfad *)
  122.  IF NOT(Flag) THEN
  123.   ReportCEDError();
  124.   RETURN
  125.  END;
  126.  
  127.  Help:=Status^;
  128.  i:=0;
  129.  WHILE (Help[i]#'.') AND (i<FChars+DSize) DO INC(i) END; (* Nach . suchen *)
  130.  IF i=FChars+DSize THEN Ext:=''; RETURN END;
  131.  Ext[0]:=Help[i]; Ext[1]:=Help[i+1];
  132.  Ext[2]:=Help[i+2]; Ext[3]:=Help[i+3]; Ext[4]:=CHAR(0);
  133.  KillString(Status)
  134. END GetCEDFileExtension;
  135.  
  136. PROCEDURE GetCEDFileName(VAR Name:PathType;PathSort:Sort);
  137.  
  138. VAR Flag:BOOLEAN;
  139.     i:INTEGER;
  140.     Help:PathType;
  141.  
  142. BEGIN
  143.  Name:='';
  144.  Help:='Status ';
  145.  IF PathSort=FullPath THEN
  146.   Concat(Help,'19')
  147.  ELSE
  148.   Concat(Help,'21')
  149.  END;
  150.  
  151.  Flag:=TalkCED(Help);
  152.  IF NOT (Flag) THEN
  153.   ReportCEDError();
  154.   RETURN
  155.  END;
  156.  
  157.  Help:=Status^;
  158.  i:=0;
  159.  WHILE (i<(1+FChars+DSize)) AND (Help[i]#'.') DO INC(i) END;
  160.  Help[i]:=CHAR(0);
  161.  Name:=Help;
  162.  KillString(Status)
  163. END GetCEDFileName;
  164.  
  165. PROCEDURE NameLen(Ptr:ADDRESS):INTEGER; (* Wird benoetigt weil CED oft   *)
  166.                                         (* keine nullterminierte Strings *)
  167. TYPE IntPtr=POINTER TO LONGINT;         (* zurueckliefert                *)
  168.  
  169. VAR IPtr:IntPtr;
  170.  
  171. BEGIN
  172.  IPtr:=Ptr;
  173.  DEC(IPtr,4);
  174.  RETURN IPtr^
  175. END NameLen;
  176.  
  177. PROCEDURE GetCEDPath(VAR Path:PathType);
  178.  
  179. VAR i:INTEGER;
  180.     Help:PathType;
  181.  
  182. BEGIN
  183.  Path:='';
  184.  
  185.  Help:='Status 19';
  186.  Flag:=TalkCED(Help);
  187.  IF NOT (Flag) THEN
  188.   ReportCEDError();
  189.   RETURN
  190.  END;
  191.  
  192.  Help:=Status^;
  193.  i:=NameLen(Status);
  194.  WHILE (Help[i]#'/') AND (Help[i]#':') AND (i>0) DO DEC(i) END;
  195.  IF Help[i]=':' THEN
  196.   Help[i+1]:=CHAR(0)
  197.  ELSE
  198.   Help[i]:=CHAR(0)
  199.  END;
  200.  Path:=Help;
  201.  KillString(Status)
  202. END GetCEDPath;
  203.  
  204. PROCEDURE ExistFile(FileName:ARRAY OF CHAR):BOOLEAN;
  205.  
  206. VAR File:FileHandlePtr;
  207.  
  208. BEGIN
  209.  File:=Open(ADR(FileName),oldFile);
  210.  IF File=NIL THEN
  211.   RETURN FALSE
  212.  ELSE
  213.   Close(File);
  214.   RETURN TRUE
  215.  END
  216. END ExistFile;
  217.  
  218. PROCEDURE LoadErrors();
  219.  
  220. VAR Name,Name2:PathType;
  221.     Ext:ExtType;
  222.     i:CARDINAL;
  223.  
  224. BEGIN
  225.  CloseErrorFile();
  226.  ErrorsOn:=TRUE;
  227.  GetCEDFileName(Name,FullPath);
  228.  GetCEDFileExtension(Ext);Concat(Name,Ext);
  229.  Concat(Name,'e');
  230.  IF NOT(ExistErrorFile(Name)) THEN
  231.   Name:='txt/'; (* Arbeitet jemand mit txt-Dirs ??? *)
  232.   GetCEDFileName(Name2,NameOnly);
  233.   Concat(Name,Name2);Concat(Name,Ext);Concat(Name,'e');
  234.   IF NOT(ExistErrorFile(Name)) THEN
  235.    TitleMsg('Kann kein Errorfile finden ');
  236.    ErrorsOn:=FALSE;
  237.    RETURN
  238.   END
  239.  END;
  240.  OpenErrorFile(Name)
  241. END LoadErrors;
  242.  
  243. PROCEDURE FindErrors();
  244.  
  245. CONST IntLen=10;
  246.       KommandLen=20;
  247.  
  248. VAR SourcePos:LONGCARD;
  249.     i:INTEGER;
  250.     ErrorNums:ErrorFeld;
  251.     PosStr:ARRAY[0..IntLen] OF CHAR;
  252.     Msg:ARRAY[0..KommandLen] OF CHAR;
  253.     ErrMsg,OutTxt:String;
  254.     err,Flag:BOOLEAN;
  255.  
  256. BEGIN
  257.  IF ErrorsOn THEN
  258.   NextError(SourcePos,ErrorNums);
  259.   IF (SourcePos=0) AND (ErrorNums[1]=0) THEN
  260.    CloseErrorFile();
  261.    ErrorsOn:=FALSE;
  262.    TitleMsg('Kein (weiterer) Fehler gefunden');
  263.    Flag:=PutMsg2CED('Jump To Byte 0');
  264.    RETURN
  265.   END;
  266.  
  267.   ValToStr(SourcePos,FALSE,PosStr,10,-1*SIZE(PosStr),CHAR(0),err);
  268.   IF err THEN
  269.    TitleMsg('Interner Fataler Fehler I');DisplayBeep(NIL);Delay(50);RETURN;
  270.   END;
  271.   Msg:='Jump To Byte ';Concat(Msg,PosStr);
  272.   Flag:=PutMsg2CED(Msg);
  273.   IF NOT(Flag) THEN
  274.    PosStr:='0';
  275.    ReportCEDError()
  276.   END;
  277.  
  278.   i:=1;
  279.   OutTxt:='';
  280.   WHILE ErrorNums[i]#0 DO
  281.    FindMsg(Root,ErrorNums[i],ErrMsg);
  282.    Concat(OutTxt,ErrMsg);
  283.    Concat(OutTxt,' ');
  284.    INC(i)
  285.   END;
  286.   TitleMsg(OutTxt);
  287.  END
  288. END FindErrors;
  289.  
  290. PROCEDURE Compile(VAR Compiled:BOOLEAN);
  291.  
  292. VAR Name,Name2,Name3:PathType;
  293.     Dummy,Offset:LONGINT;
  294.     out,help:FileHandlePtr;
  295.     Kommando:ARRAY [0..DSize+FChars+5] OF CHAR;
  296.     Flag,ChgDir:BOOLEAN;
  297.     Ext:ExtType;
  298.     Title:DosWin;
  299.  
  300. BEGIN
  301.  ErrorsOn:=FALSE;
  302.  CloseErrorFile();
  303.  
  304.  Title:='';Concat(Title,Para.Window);Concat(Title,'M2C Compiling ...');
  305.  out:=Open(ADR(Title),newFile);
  306.  
  307.  Kommando:='';Concat(Kommando,Para.CompilerName);
  308.  IF (Argc>0) AND (Arg.NameO^) THEN
  309.   GetCEDPath(Name);
  310.   ChangeDir(Name); (* Compile im aktuellen Dir laufen lassen ! *)
  311.   GetCEDFileName(Name,NameOnly);
  312.  ELSE
  313.   GetCEDFileName(Name,FullPath)
  314.  END;
  315.  Concat(Kommando,Name);
  316.  GetCEDFileExtension(Ext);
  317.  IF NOT(Arg.NoRestart^) THEN (* Restartfile schreiben ?? *)
  318.   GetCEDFileName(Name3,FullPath);Concat(Name3,Ext);
  319.   Flag:=TalkCED('Status 56');
  320.   OffSet:=Ergeb;
  321.   Flag:=TalkCED('Status 46');
  322.   OffSet:=OffSet+Ergeb; (* Bestimme Byteoffset im File *)
  323.   WriteFile(Name3,OffSet) (* Fuer Neustart *)
  324.  END;
  325.  
  326.  IF (Compare(Ext,'.def')=0) THEN Concat(Kommando,Ext) END;
  327.  Flag:=WBenchToFront();
  328.  IF NOT(Arg.NoVersion^) THEN UpdateVersion() END;
  329.  Flag:=PutMsg2CED("Save all Changes");
  330.  
  331.  Dummy:=Execute(ADR(Kommando),NIL,out);
  332.  
  333.  (* Name normale Fehlerdatei Name2 Fehlerdatei in TXT Dir *)
  334.  Concat(Name,Ext);Concat(Name,'e');
  335.  GetCEDFileName(Name3,NameOnly);
  336.  Name2:='txt/';
  337.  Concat(Name2,Name3);Concat(Name2,Ext);Concat(Name2,'e');
  338.  IF ExistErrorFile(Name) OR ExistErrorFile(Name2) THEN  (* Festellen ob Fehler*)
  339.   Dummy:=Write(out,ADR(Para.ContMsg),SIZE(Para.ContMsg));
  340.   Cont();
  341.   Flag:=PutMsg2CED('CEDToFront');
  342.   LoadErrors();
  343.   FindErrors()
  344.  ELSE
  345.   Flag:=PutMsg2CED('CEDToFront');
  346.   Compiled:=TRUE (* Compiler ist ohne Fehler durchgelaufen *)
  347.  END;
  348.  Close(out)
  349. END Compile;
  350.  
  351. PROCEDURE Link(VAR Compiled:BOOLEAN; Opti:BOOLEAN);
  352.  
  353. VAR Name:PathType;
  354.     Dummy:LONGINT;
  355.     out:FileHandlePtr;
  356.     Kommando:ARRAY [0..DSize+FChars+5] OF CHAR;
  357.     Flag:BOOLEAN;
  358.     Ext:ExtType;
  359.     Title:DosWin;
  360.  
  361. BEGIN
  362.  ErrorsOn:=FALSE;
  363.  CloseErrorFile();
  364.  GetCEDFileName(Name,NameOnly);
  365.  
  366.  GetCEDFileExtension(Ext);
  367.  IF (Compare(Ext,'.def')=0) THEN
  368.   TitleMsg('.DEF Files koennen nicht gelinkt werden !!!');
  369.   RETURN
  370.  END;
  371.  
  372.  Title:='';Concat(Title,Para.Window);Concat(Title,'M2L Linking ...');
  373.  out:=Open(ADR(Title),newFile);
  374.  IF Opti THEN
  375.   Kommando:='';Concat(Kommando,Para.OptimizerName);
  376.  ELSE
  377.   Kommando:='';Concat(Kommando,Para.LinkerName);
  378.  END;
  379.  Concat(Kommando,Name);
  380.  Flag:=WBenchToFront();
  381.  Dummy:=Execute(ADR(Kommando),NIL,out);
  382.  Delay(25); (* Noch warten *)
  383.  Flag:=PutMsg2CED('CEDToFront');
  384.  Close(out);
  385.  
  386.  Delay(25); (* Noch warten *)
  387.  IF NOT(Compiled) THEN
  388.   TitleMsg('Warning: Compiler war vor dem Linker nicht aktiv !!')
  389.  END;
  390.  Compiled:=FALSE
  391. END Link;
  392.  
  393. PROCEDURE Start();
  394.  
  395. VAR Name:PathType;
  396.     Dummy:LONGINT;
  397.     Flag,Enter:BOOLEAN;
  398.     inout:FileHandlePtr;
  399.     Title:DosWin;
  400.  
  401. BEGIN
  402.  ErrorsOn:=FALSE;
  403.  CloseErrorFile();
  404.  GetCEDFileName(Name,NameOnly);
  405.  
  406.  Flag:=WBenchToFront();
  407.  Title:='';Concat(Title,Para.Window);Concat(Title,'M2 Executing ...');
  408.  inout:=Open(ADR(Title),readWrite);
  409.  IF Arg.Argument^ THEN
  410.   Enter:=GetString(ADR(StartArgument),ADR('Argument ?'),NIL,20,
  411.                    SIZE(StartArgument)-1);
  412.   IF NOT(Enter) THEN StartArgument:='' END;
  413.   Dummy:=SyncRun(ADR(Name),ADR(StartArgument),inout,inout);
  414.  ELSE
  415.   Dummy:=SyncRun(ADR(Name),NIL,inout,inout);
  416.  END;
  417.  Dummy:=Write(inout,ADR(Para.ContMsg),SIZE(Para.ContMsg));
  418.  Cont();
  419.  Close(inout);
  420.  Flag:=PutMsg2CED('CEDToFront');
  421. END Start;
  422.  
  423. BEGIN
  424.  
  425.  Arg.NameO^:=FALSE;
  426.  Arg.Argument^:=FALSE;
  427.  Arg.NoRestart^:=FALSE;
  428.  Arg.NoVersion^:=FALSE;
  429.  Argc:=GADS(dosCmdBuf,dosCmdLen,ADR(HelpMsg),ADR(Arg),ADR(Template));
  430.  
  431.  StartArgument:='';
  432.  ReadList(Root);
  433.  
  434.  ErrorsOn:=FALSE;
  435.  Flag:=PutMsg2CED('CEDToFront');
  436.  IF NOT Flag THEN ReportCEDError() END;
  437.  
  438.  IF NOT(Arg.NoRestart^) THEN
  439.   ReadFile(OldFile,OffSet); (* evtl. altes File und Offset laden *)
  440.   ValToStr(OffSet,FALSE,JumpNo,10,-SIZE(JumpNo),CHAR(0),Flag);
  441.   (* Byteoffset ausrechnen *)
  442.   IF Flag THEN
  443.    Request('Kann Cursor nicht positionieren');
  444.    JumpNo:='0'
  445.   END;
  446.   Jump:='Jump To Byte ';Concat(Jump,JumpNo);
  447.   Flag:=PutMsg2CED(Jump);
  448.   OpenName:='Open ';
  449.   Concat(OpenName,OldFile)
  450.  ELSE
  451.   OpenName:='Open';
  452.   JumpNo:='0';
  453.  END;
  454.  Flag:=PutMsg2CED(OpenName);
  455.  Jump:='Jump To Byte ';Concat(Jump,JumpNo);
  456.  Flag:=PutMsg2CED(Jump);
  457.  
  458.  Delay(25);
  459.  CopyRightMsg:=CopyRightMsgC;
  460.  TitleMsg(CopyRightMsg);
  461.  
  462.  Compiled:=FALSE; (* Flag ob Compiler vor Linker gelaufen ist *)
  463.  
  464.  LOOP
  465.   CASE KeyPressed() OF
  466.    |compile:Compile(Compiled);
  467.    |link:Link(Compiled,FALSE);
  468.    |opt:Link(Compiled,TRUE);
  469.    |start:Start();
  470.    |findError:FindErrors();
  471.    |load:LoadErrors();
  472.    |cancel:DisplayBeep(NIL);EXIT;
  473.   ELSE
  474.   END
  475.  END;
  476.  
  477.  KillList(Root);
  478. END M2CED.
  479.